--{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE FlexibleContexts, TypeFamilies,
  FlexibleInstances, MultiParamTypeClasses, 
  FunctionalDependencies, TypeSynonymInstances #-}

module Rectangle where

import Projectable
import Vector2D
import Point2D
import Size
import Math
import Data.VectorSpace hiding (Scalar)
import Data.AffineSpace
import Control.Parallel.Strategies

data Rectangle = RC !Point2 -- ^ Top-left point
                    !Point2 -- ^ Bottom-right point
                    deriving Eq

instance Show Rectangle where
  show (RC p1 p2) = show p1++"-"++show (p2 .-. p1)

-- | Type class to allow construction of rectangle 
-- | using either two points or a point and a size.
-- | Not sure if this is good functional programming style,
-- | it might be better to provide constructors with different names?
class IsRectangular a b  | b -> a where
  rect :: a -> b -> Rectangle

instance IsRectangular Point2 Point2 where
  rect p1 p2 = (p1 `min2` p2) `RC` (p1 `max2` p2)

instance IsRectangular Point2 Vector2 where
  rect p1 v = rect p1 (p1 .+^ v)

instance IsRectangular Point2 Size where
  rect p1 sz = rect p1 (unSZ sz)

instance ProjectX Rectangle where
  getX (RC p _) = getX p
  mapX f (RC p q) = RC (mapX f p) q

instance ProjectY Rectangle where
  getY (RC p _) = getY p
  mapY f (RC p q) = RC (mapY f p) q

instance IsSize Rectangle where
  getSize (RC p q) = SZ (q .-. p)
  getWidth = getX . unSZ . getSize
  getHeight = getY . unSZ . getSize
  mapSize f (RC p q) = rect p (f (SZ (q .-. p))) 
  mapWidth f (RC p q) = rect p (mapX f (q .-. p))
  mapHeight f (RC p q) = rect p (mapY f (q .-. p))
  
-- | Shrink the rectangle around it's center.
shrinkBy :: Vector2 -> Rectangle -> Rectangle
shrinkBy amount (tl `RC` br) = RC (tl .+^ amount) (br .-^ amount)

-- | Expand the rectangle around it's center.
expandBy :: Vector2 -> Rectangle -> Rectangle
expandBy = shrinkBy . negateV
  
-- | Check if the rectangle contains a point.
containsPt :: Rectangle -> Point2 -> Bool
containsPt (P2 (V2 x1 y1) `RC` P2 (V2 x2 y2)) (P2 (V2 x y)) = 
  x1 <= x && x < x2 && 
  y1 <= y && y < y2

-- | Convert relative "texture" coordinates (u,v) to rectangle coordinates
-- | (u,v) is inside the rectangle when 0 <= u <= 1 and 0 <= v <= 1
uvToRectPt :: Point2 -> Rectangle -> Point2
uvToRectPt (P2 (V2 u v)) (P2 (V2 x1 y1) `RC` P2 (V2 x2 y2)) = 
  P2 $ V2 (x1 + (x2-x1)*u) (y1 + (y2-y1)*v)

-- | Convert rectangle coordinates to relative "texture" coordinates (u,v)
-- | (u,v) is inside the rectangle when 0 <= u <= 1 and 0 <= v <= 1
rectToUvPt :: Point2 -> Rectangle -> Point2
rectToUvPt (P2 (V2 x y)) (P2 (V2 x1 y1) `RC` P2 (V2 x2 y2)) = 
  P2 $ V2 (x / (x2-x1)) (y / (y2-y1))

-- | Creates a rectangle around a pivot point
pivotRect :: Point2 -> Size -> Vector2 -> Rectangle
pivotRect pivotPt (SZ (V2 w h)) (V2 u v) = rect (pivotPt .-^ d1) (pivotPt .+^ d2)
  where
    d1 = V2 (u*w) (v*h)
    d2 = V2 ((1-u)*w) ((1-v)*h)
   

-- | Get top-left point of rectangle
getTopLeftPt :: Rectangle -> Point2
getTopLeftPt (RC p1 _) = p1

-- | Get top-right point of rectangle
getTopRightPt :: Rectangle -> Point2
getTopRightPt (P2 (V2 _ y1) `RC` P2 (V2 x2 _)) = P2 $ V2 x2 y1

-- | Get bottom-left point of rectangle
getBottomLeftPt :: Rectangle -> Point2
getBottomLeftPt (P2 (V2 x1 _) `RC` P2 (V2 _ y2)) = P2 $ V2 x1 y2

-- | Get bottom-right point of rectangle
getBottomRightPt :: Rectangle -> Point2
getBottomRightPt (RC _ p2) = p2

zipRects :: (Point2 -> Point2 -> Point2) -> 
            (Point2 -> Point2 -> Point2) ->
            Rectangle -> Rectangle -> Rectangle
zipRects tlf brf rect1 rect2 = RC (tl1 `tlf` tl2) (br1 `brf` br2) 
  where
    tl1 = getTopLeftPt rect1
    tl2 = getTopLeftPt rect2
    br1 = getBottomRightPt rect1
    br2 = getBottomRightPt rect2

-- | Intersection between two rectangles.
-- | Might result in an empty rectangle if no intersection exists.
intersection :: Rectangle -> Rectangle -> Rectangle
intersection = zipRects max2 min2

-- | Union of two rectangles. 
-- | Well actually not the union in the set sense,
-- | but the smallest rectangle that contains both rectangles.
union :: Rectangle -> Rectangle -> Rectangle
union = zipRects min2 max2

-- | A rectangle is empty when either its width or height 
-- | is negative or zero
isEmpty :: Rectangle -> Bool
isEmpty rc = getWidth rc <= 0 || getHeight rc <= 0

-- | Check if two rectangles intersect
intersects :: Rectangle -> Rectangle -> Bool
rc1 `intersects` rc2 = not . isEmpty $ rc1 `intersection` rc2

instance NFData (Rectangle)

